Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Think Class Libraries/CBartenderHelpMenu.p 1.0/CBartenderHelpMenu.p

Text File | 1996-01-10 | 11.9 KB | 350 lines | [TEXT/PJMM]

{****************************************************}
{}
{        CBartenderHelpMenu.p                                                                                                                                                                            }
{}
{        SUPERCLASS = CBartender                                                                                                                                                            }
{}
{        Copyright © 1995 Patrick C Hew. All rights reserved.                                                                        }
{}
{        CBartenderHelpMenu is a bartender which handles items in the application                }
{        help menu. This is the part of the help menu below the standard help menu                }
{        items. This class does not "own" the application help menu in any way. It                    }
{        merely calls the appropriate Help Manager routines.                                                                                }
{}
{        If a item is selected from the help menu, the command value generated has                }
{        a negative value. Following standard TCL practice, you should negate this                    }
{        value and obtain the high and low words. The high word is the menu ID,                         }
{        namely kHMHelpMenuID. However the low word is the position in the                                 }
{        application help menu. This corrects for the presence of the standard items.            }
{}
{        Your DoCommand procedure for the object handling help could thus have –                }
{}
{        if HiWord(-theCommand) = kHMHelpMenuID then begin                                                                            }
{                DoAppHelpMenuItem(LoWord(-theCommand));                                                                                            }
{        end;                                                                                                                                                                                                                                }
{}
{        At time of writing, the number of standard items in the help menu may be                 }
{        taken as constant.    If this changes     in the future, then this class will need to            }
{        be revised.                                                                                                                                                                                                            }
{}
{        Important: You must override MakeBartender and assign gBartender to be an        }
{        object of CBartenderHelpMenu type, not of CBartender, as follows –                                 }
{}
{        procedure CMyApp.MakeBartender;                                                                                                                                    }
{}
{            var                                                                                                                                                                                                                                }
{                    theBartenderHM : CBartenderHelpMenu;                                                                                                        }
{}
{        begin                                                                                                                                                                                                                             }
{            new(theBartenderHM);                                                                                                                                                                    }
{            gBartender := theBartenderHM;                                                                                                                                            }
{            theBartenderHM.IBartenderHelpMenu(MBARapp);                                                                                        }
{        end;                                                                                                                                                                                                                                }
{}
{        Version History –                                                                                                                                                                                        }
{}
{        Version:    1.00 for TCL 1.1.2                                                                                                                                                        }
{        Date:             06 January 1995                                                                                                                                                            }
{        Author:        Patrick C Hew     <[e-mail]>                                                                                }
{        Notes:            Initial release.                                                                                                                                                                        }
{                                    Based on C source code by Mark Coniglio, and following some ideas        }
{                                    from Ken Beath.                                                                                                                                                                }
{}
{****************************************************}


unit CBartenderHelpMenu;

interface

    uses
        TCL;

    type
        CBartenderHelpMenu = object(CBartender)

                { The number of standard items in the help menu, above the application help menu. }
                { This value is initialized when the object is initialized. At time of writing, the }
                { number of such items is constant. }
                numStandardHelpMenuItems: Integer;

                { The number of items in the application help menu. This is what we are managing. }
                { At all times, we should have that }
                { numStandardHelpMenuItems + numApplicationHelpMenuItems = CountMItems(GetMHandle(kHMHelpMenuID)) }
                { That is, our record of the number of standard and application items in the help menu is }
                { actually what is there. }
                numApplicationHelpMenuItems: Integer;

                { Initialize a bartender object which handles items in the application help menu. }
                procedure IBartenderHelpMenu (MBARid: integer);

                { Find the command number corresponding to the specified Menu choice, }
                { as specified by a MENU resource ID and item number. }
                function FindCmdNumber (MENUid: Integer; itemNo: Integer): LongInt;
                override;

                { Adds the requested items to the application help menu from a STR# resource. }
                { The procedure does not process the strings for metacharacters, except for }
                { processing a '-' into a dividing line. We disable the selectability of these lines. }
                procedure AddHelpMenuItems (resID: Integer; max: Integer);

                { Inserts the specified string as a new item in the application help menu. }
                { The procedure does not process the strings for metacharacters, except for }
                { processing a '-' into a dividing line. We disable the selectability of these lines. }
                procedure Insert1HelpMenuItem (str: Str255; afterItem: Integer);

                { Remove all items from the application help menu. }
                procedure RemoveHelpMenuItems;

                { Remove the specified item from the application help menu. }
                procedure Remove1HelpMenuItem (itemNo: Integer);

            end; { CBartenderHelpMenu }


implementation


{****************************************************}
{}
{        IBartenderHelpMenu                                                                                                                                                                                }
{}
{        Initialize a bartender object which handles items in the help menu.                                        }
{}
{****************************************************}

    procedure CBartenderHelpMenu.IBartenderHelpMenu (MBARid: integer);

        var
            help: MenuHandle;

    begin { IBartenderHelpMenu }
        IBartender(MBARid);

        numStandardHelpMenuItems := 0;
        numApplicationHelpMenuItems := 0;

        if gSystem.hasHelpMgr then begin

            { To count the number of standard items in the help menu, }
            { we need a handle to the global help menu, not just the }
            { application one. }

            help := GetMHandle(kHMHelpMenuID);

            { Note that the Help Manager adds a separating line between }
            { the standard and application help menus. We include this }
            { line in the count of the standard items. }

            if help <> nil then begin
                numStandardHelpMenuItems := CountMItems(help) + 1;
            end; { if }
        end; { if }
    end; { IBartenderHelpMenu }


{****************************************************}
{}
{        FindCmdNumber                                                                                                                                                                                                }
{}
{        Find the command number corresponding to the specified Menu choice,                            }
{        as specified by a MENU resource ID and item number.                                                                                }
{}
{****************************************************}

    function CBartenderHelpMenu.FindCmdNumber (MENUid: Integer; itemNo: Integer): LongInt;

    begin { FindCmdNumber }
        if gSystem.hasHelpMgr and (MENUid = kHMHelpMenuID) then begin
            FindCmdNumber := -BSL(LongInt(MENUid), 16) - (itemNo - numStandardHelpMenuItems);
        end { if }
        else begin
            FindCmdNumber := inherited FindCmdNumber(MENUid, itemNo);
        end { else if }
    end; { FindCmdNumber }


{****************************************************}
{}
{        AddHelpMenuItems                                                                                                                                                                                    }
{}
{        The procedure does not process the strings for metacharacters, except for            }
{        processing a '-' into a dividing line. We disable the selectability of these lines.    }
{}
{****************************************************}

    procedure CBartenderHelpMenu.AddHelpMenuItems (resID: Integer; max: Integer);

        var
            i: Integer;
            help: MenuHandle;
            hcount: Integer;
            str: Str255;
            err: OSErr;

    begin { AddHelpMenuItems }
        if gSystem.hasHelpMgr then begin

            err := HMGetHelpMenuHandle(help);

            if err = noErr then begin
                { Application help menu exists. Count the current number of items. }
                hcount := CountMItems(help);

                for i := 1 to max do begin
                    GetIndString(str, resID, i);

                    { We can't process for metacharacters, otherwise we might add multiple }
                    { menus for a single string. However SetItem processes '-' into item }
                    { separators, which we should disable. }

                    { Important – Add a blank string, not an empty one. }
                    AppendMenu(help, ' ');
                    SetItem(help, hcount + i, str);

                    numApplicationHelpMenuItems := numApplicationHelpMenuItems + 1;

                    if str = '-' then begin
                        DisableItem(help, hcount + i)
                    end { if }
                    else begin
                        EnableItem(help, hcount + i);
                    end; { else }

                end; { for }
            end; { if }

            ASSERT(numStandardHelpMenuItems + numApplicationHelpMenuItems = CountMItems(GetMHandle(kHMHelpMenuID)));
        end; { if }
    end; { AddHelpMenuItems }


{****************************************************}
{}
{        Add1HelpMenuItem                                                                                                                                                                                    }
{}
{        Inserts the specified string as a new item in the application help menu.                            }
{        The procedure does not process the strings for metacharacters, except for            }
{        processing a '-' into a dividing line. We disable the selectability of these lines.     }
{}
{****************************************************}

    procedure CBartenderHelpMenu.Insert1HelpMenuItem (str: Str255; afterItem: Integer);

        var
            help: MenuHandle;
            err: OSErr;

    begin { Insert1HelpMenuItem }
        if gSystem.hasHelpMgr then begin

            err := HMGetHelpMenuHandle(help);

            if err = noErr then begin
                { Application help menu exists. }

                { We can't process for metacharacters, otherwise we might add multiple }
                { menus for a single string. However SetItem processes '-' into item }
                { separators, which we should disable. }

                { In spite of what is implied in the documentation, HMGetHelpMenuHandle }
                { actually appears to be a handle to the global help menu. To get the }
                { correct effect, we have to offset. }

                { Important – Insert a blank string, not an empty one. }
                InsMenuItem(help, ' ', numStandardHelpMenuItems + afterItem);
                SetItem(help, numStandardHelpMenuItems + afterItem + 1, str);

                numApplicationHelpMenuItems := numApplicationHelpMenuItems + 1;

                if str = '-' then begin
                    DisableItem(help, numStandardHelpMenuItems + afterItem + 1)
                end { if }
                else begin
                    EnableItem(help, numStandardHelpMenuItems + afterItem + 1);
                end; { else }

            end; { if }

            ASSERT(numStandardHelpMenuItems + numApplicationHelpMenuItems = CountMItems(GetMHandle(kHMHelpMenuID)));
        end; { if }
    end; { Insert1HelpMenuItem }


{****************************************************}
{}
{        RemoveHelpMenuItems                                                                                                                                                                        }
{}
{        Remove all items from the application help menu.                                                                                            }
{}
{****************************************************}

    procedure CBartenderHelpMenu.RemoveHelpMenuItems;

        var
            help: MenuHandle;
            hcount: Integer;
            err: OSErr;

    begin { RemoveHelpMenuItems }
        if gSystem.hasHelpMgr then begin

            err := HMGetHelpMenuHandle(help);

            if err = noErr then begin
                { Application help menu exists. Count the current number of items. }
                hcount := CountMItems(help);

                while numApplicationHelpMenuItems > 0 do begin
                    { Delete the last item. }
                    DelMenuItem(help, hcount);

                    { Decrement the count. }
                    hcount := hcount - 1;
                    numApplicationHelpMenuItems := numApplicationHelpMenuItems - 1;
                end; { while }
            end; { if }

            ASSERT(numStandardHelpMenuItems + numApplicationHelpMenuItems = CountMItems(GetMHandle(kHMHelpMenuID)));
        end; { if }
    end; { RemoveHelpMenuItems }


{****************************************************}
{}
{        Remove1HelpMenuItem                                                                                                                                                                        }
{}
{        Remove the specified item from the application help menu.                                                                }
{}
{****************************************************}

    procedure CBartenderHelpMenu.Remove1HelpMenuItem (itemNo: Integer);

        var
            help: MenuHandle;
            err: OSErr;
            macMenu: MenuHandle;
            i, oldNumCmds: Integer;

    begin { Remove1HelpMenuItem }
        if gSystem.hasHelpMgr and (numApplicationHelpMenuItems > 0) then begin

            err := HMGetHelpMenuHandle(help);

            if err = noErr then begin

                { In spite of what is implied in the documentation, HMGetHelpMenuHandle }
                { actually appears to be a handle to the global help menu. To get the }
                { correct effect, we have to offset. }

                DelMenuItem(help, numStandardHelpMenuItems + itemNo);

                numApplicationHelpMenuItems := numApplicationHelpMenuItems - 1;
            end; { if }

            ASSERT(numStandardHelpMenuItems + numApplicationHelpMenuItems = CountMItems(GetMHandle(kHMHelpMenuID)));
        end; { if }
    end; { Remove1HelpMenuItem }


end. { CBartenderHelpMenu }